home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / src / marker.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-05-25  |  9.5 KB  |  373 lines
  1. /* Markers: examining, setting and killing.
  2.    Copyright (C) 1985, 1992, 1993, 1994 Free Software Foundation, Inc.
  3.  
  4. This file is part of XEmacs.
  5.  
  6. XEmacs is free software; you can redistribute it and/or modify it
  7. under the terms of the GNU General Public License as published by the
  8. Free Software Foundation; either version 2, or (at your option) any
  9. later version.
  10.  
  11. XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14. for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with XEmacs; see the file COPYING.  If not, write to the Free
  18. Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. /* Synched up with: FSF 19.28. */
  21.  
  22. /* This file has been Mule-ized. */
  23.  
  24. /* Note that markers are currently kept in an unordered list.
  25.    This means that marker operations may be inefficient if
  26.    there are a bunch of markers in the buffer.  This probably
  27.    won't have a significant impact on redisplay (which uses
  28.    markers), but if it does, it wouldn't be too hard to change
  29.    to an ordered gap array. (Just copy the code from extents.c.)
  30.    */
  31.  
  32. #include <config.h>
  33. #include "lisp.h"
  34.  
  35. #include "buffer.h"
  36.  
  37. static Lisp_Object mark_marker (Lisp_Object, void (*) (Lisp_Object));
  38. static void print_marker (Lisp_Object, Lisp_Object, int);
  39. static int marker_equal (Lisp_Object, Lisp_Object, int);
  40. static unsigned long marker_hash (Lisp_Object obj, int depth);
  41. DEFINE_LRECORD_IMPLEMENTATION ("marker", marker,
  42.                                mark_marker, print_marker, 0, marker_equal,
  43.                    marker_hash, struct Lisp_Marker);
  44.  
  45. static Lisp_Object
  46. mark_marker (Lisp_Object obj, void (*markobj) (Lisp_Object))
  47. {
  48.   struct Lisp_Marker *marker = XMARKER (obj);
  49.   Lisp_Object buf;
  50.   /* DO NOT mark through the marker's chain.
  51.      The buffer's markers chain does not preserve markers from gc;
  52.      Instead, markers are removed from the chain when they are freed
  53.      by gc.
  54.    */
  55.   if (!marker->buffer)
  56.     return (Qnil);
  57.  
  58.   XSETBUFFER (buf, marker->buffer);
  59.   return (buf);
  60. }
  61.  
  62. static void
  63. print_marker (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
  64. {
  65.   if (print_readably)
  66.     error ("printing unreadable object #<marker>");
  67.       
  68.   write_c_string (GETTEXT ("#<marker "), printcharfun);
  69.   if (!(XMARKER (obj)->buffer))
  70.     write_c_string (GETTEXT ("in no buffer"), printcharfun);
  71.   else
  72.     {
  73.       char buf[200];
  74.       sprintf (buf, "at %d", marker_position (obj));
  75.       write_c_string (buf, printcharfun);
  76.       write_c_string (" in ", printcharfun);
  77.       print_internal (XMARKER (obj)->buffer->name, printcharfun, 0);
  78.     }
  79.   write_c_string (">", printcharfun);
  80. }
  81.  
  82. static int
  83. marker_equal (Lisp_Object o1, Lisp_Object o2, int depth)
  84. {
  85.   struct buffer *b1 = XMARKER (o1)->buffer;
  86.   if (b1 != XMARKER (o2)->buffer)
  87.     return (0);
  88.   else if (!b1)
  89.     /* All markers pointing nowhere are equal */
  90.     return (1);
  91.   else
  92.     return ((XMARKER (o1)->memind == XMARKER (o2)->memind));
  93. }
  94.  
  95. static unsigned long
  96. marker_hash (Lisp_Object obj, int depth)
  97. {
  98.   unsigned long hash = (unsigned long) XMARKER (obj)->buffer;
  99.   if (hash)
  100.     hash = HASH2 (hash, XMARKER (obj)->memind);
  101.   return hash;
  102. }
  103.  
  104.  
  105. /* Operations on markers. */
  106.  
  107. DEFUN ("marker-buffer", Fmarker_buffer, Smarker_buffer, 1, 1, 0,
  108.   "Return the buffer that MARKER points into, or nil if none.\n\
  109. Returns nil if MARKER points into a dead buffer.")
  110.   (marker)
  111.      Lisp_Object marker;
  112. {
  113.   Lisp_Object buf;
  114.   CHECK_MARKER (marker, 0);
  115.   if (XMARKER (marker)->buffer)
  116.     {
  117.       XSETBUFFER (buf, XMARKER (marker)->buffer);
  118.       /* Return marker's buffer only if it is not dead.  */
  119.       if (BUFFER_LIVE_P (XBUFFER (buf)))
  120.     return buf;
  121.     }
  122.   return Qnil;
  123. }
  124.  
  125. DEFUN ("marker-position", Fmarker_position, Smarker_position, 1, 1, 0,
  126.   "Return the position MARKER points at, as a character number.\n\
  127. Returns `nil' if marker doesn't point anywhere.")
  128.   (marker)
  129.      Lisp_Object marker;
  130. {
  131.   CHECK_MARKER (marker, 0);
  132.   if (XMARKER (marker)->buffer)
  133.     {
  134.       return (make_number (marker_position (marker)));
  135.     }
  136.   return Qnil;
  137. }
  138.  
  139.  
  140. static Lisp_Object
  141. set_marker_internal (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer,
  142.              int restricted_p)
  143. {
  144.   Bufpos charno;
  145.   struct buffer *b;
  146.   struct Lisp_Marker *m;
  147.   int point_p;
  148.  
  149.   CHECK_MARKER (marker, 0);
  150.  
  151.   point_p = POINT_MARKER_P (marker);
  152.  
  153.   /* If position is nil or a marker that points nowhere,
  154.      make this marker point nowhere.  */
  155.   if (NILP (pos) ||
  156.       (MARKERP (pos) && !XMARKER (pos)->buffer))
  157.     {
  158.       if (point_p)
  159.     signal_simple_error ("can't make point-marker point nowhere",
  160.                  marker);
  161.       if (XMARKER (marker)->buffer)
  162.     unchain_marker (marker);
  163.       return marker;
  164.     }
  165.  
  166.   CHECK_INT_COERCE_MARKER (pos, 1);
  167.   if (NILP (buffer))
  168.     b = current_buffer;
  169.   else
  170.     {
  171.       CHECK_BUFFER (buffer, 1);
  172.       b = XBUFFER (buffer);
  173.       /* If buffer is dead, set marker to point nowhere.  */
  174.       if (!BUFFER_LIVE_P (XBUFFER (buffer)))
  175.     {
  176.       if (point_p)
  177.         signal_simple_error
  178.           ("can't move point-marker in a killed buffer", marker);
  179.       if (XMARKER (marker)->buffer)
  180.         unchain_marker (marker);
  181.       return marker;
  182.     }
  183.     }
  184.  
  185.   charno = XINT (pos);
  186.   m = XMARKER (marker);
  187.  
  188.   if (restricted_p)
  189.     {
  190.       if (charno < BUF_BEGV (b)) charno = BUF_BEGV (b);
  191.       if (charno > BUF_ZV (b)) charno = BUF_ZV (b);
  192.     }
  193.   else
  194.     {
  195.       if (charno < BUF_BEG (b)) charno = BUF_BEG (b);
  196.       if (charno > BUF_Z (b)) charno = BUF_Z (b);
  197.     }
  198.  
  199.   if (point_p)
  200.     {
  201. #ifdef moving_point_by_moving_its_marker_is_a_feature
  202.       BUF_SET_PT (b, charno);    /* this will move the marker */
  203. #else  /* It's not a feature, so it must be a bug */
  204.       signal_simple_error ("DEBUG: attempt to move point via point-marker",
  205.                marker);
  206. #endif
  207.     }
  208.   else
  209.     {
  210.       m->memind = bufpos_to_memind (b, charno);
  211.     }
  212.  
  213.   if (m->buffer != b)
  214.     {
  215.       if (point_p)
  216.     signal_simple_error ("can't change buffer of point-marker", marker);
  217.       if (m->buffer != 0)
  218.     unchain_marker (marker);
  219.       marker_next (m) = b->markers;
  220.       b->markers = m;
  221.       m->buffer = b;
  222.     }
  223.   
  224.   return marker;
  225. }
  226.  
  227.  
  228. DEFUN ("set-marker", Fset_marker, Sset_marker, 2, 3, 0,
  229.   "Position MARKER before character number NUMBER in BUFFER.\n\
  230. BUFFER defaults to the current buffer.\n\
  231. If NUMBER is nil, makes marker point nowhere.\n\
  232. Then it no longer slows down editing in any buffer.\n\
  233. If this marker was returned by (point-marker t), then changing its position\n\
  234. moves point.  You cannot change its buffer or make it point nowhere.\n\
  235. Returns MARKER.")
  236.   (marker, pos, buffer)
  237.      Lisp_Object marker, pos, buffer;
  238. {
  239.   return set_marker_internal (marker, pos, buffer, 0);
  240. }
  241.  
  242.  
  243. /* This version of Fset_marker won't let the position
  244.    be outside the visible part.  */
  245. Lisp_Object 
  246. set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer)
  247. {
  248.   return set_marker_internal (marker, pos, buffer, 1);
  249. }
  250.  
  251.  
  252. /* This is called during garbage collection,
  253.    so we must be careful to ignore and preserve mark bits,
  254.    including those in chain fields of markers.  */
  255.  
  256. void
  257. unchain_marker (Lisp_Object m)
  258. {
  259.   struct Lisp_Marker *marker = XMARKER (m);
  260.   struct buffer *b = marker->buffer;
  261.   struct Lisp_Marker *chain, *prev, *next;
  262.  
  263.   if (b == 0)
  264.     return;
  265.  
  266.   if (EQ (b->name, Qnil))       /* killed buffer */
  267.     abort ();
  268.  
  269.   for (chain = b->markers, prev = 0; chain; chain = next)
  270.     {
  271.       next = marker_next (chain);
  272.  
  273.       if (marker == chain)
  274.     {
  275.       if (!prev)
  276.         {
  277.           b->markers = next;
  278.           /* Deleting first marker from the buffer's chain.
  279.          Crash if new first marker in chain does not say
  280.          it belongs to this buffer.  */
  281.           if (next != 0 && b != next->buffer)
  282.         abort ();
  283.         }
  284.       else
  285.         {
  286.               marker_next (prev) = next;
  287.         }
  288.       break;
  289.     }
  290.       else
  291.     prev = chain;
  292.     }
  293.  
  294.   if (marker == XMARKER (b->point_marker))
  295.     abort ();
  296.  
  297.   marker->buffer = 0;
  298. }
  299.  
  300. Bufpos
  301. marker_position (Lisp_Object marker)
  302. {
  303.   struct Lisp_Marker *m = XMARKER (marker);
  304.   struct buffer *buf = m->buffer;
  305.   Bufpos pos;
  306.  
  307.   if (!buf)
  308.     error ("Marker does not point anywhere");
  309.  
  310.   /* FSF claims that marker indices could end up denormalized, i.e.
  311.      in the gap.  This is way bogus if it ever happens, and means
  312.      something fucked up elsewhere.  Since I've overhauled all this
  313.      shit, I don't think this can happen.  In any case, the following
  314.      macro has an assert() in it that will catch these denormalized
  315.      positions. */
  316.   pos = memind_to_bufpos (buf, m->memind);
  317.  
  318.   if (pos < BUF_BEG (buf) || pos > BUF_Z (buf))
  319.     abort ();
  320.  
  321.   return pos;
  322. }
  323.  
  324. void
  325. set_marker_position (Lisp_Object marker, Bufpos pos)
  326. {
  327.   struct Lisp_Marker *m = XMARKER (marker);
  328.   struct buffer *buf = m->buffer;
  329.  
  330.   if (!buf)
  331.     error ("Marker does not point anywhere");
  332.  
  333.   if (pos < BUF_BEG (buf) || pos > BUF_Z (buf))
  334.     abort ();
  335.  
  336.   m->memind = bufpos_to_memind (buf, pos);
  337. }
  338.  
  339. DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 1, 0,
  340.   "Return a new marker pointing at the same place as MARKER.\n\
  341. If argument is a number, makes a new marker pointing\n\
  342. at that position in the current buffer.")
  343.   (marker)
  344.      Lisp_Object marker;
  345. {
  346.   Lisp_Object new;
  347.  
  348.   while (1)
  349.     {
  350.       if (INTP (marker)
  351.       || MARKERP (marker))
  352.     {
  353.        Lisp_Object buffer = (MARKERP (marker) ? Fmarker_buffer (marker)
  354.                 : Qnil);
  355.       new = Fmake_marker ();
  356.       Fset_marker (new, marker, buffer);
  357.       return new;
  358.     }
  359.       else
  360.     marker = wrong_type_argument (Qinteger_or_marker_p, marker);
  361.     }
  362. }
  363.  
  364.  
  365. void
  366. syms_of_marker (void)
  367. {
  368.   defsubr (&Smarker_position);
  369.   defsubr (&Smarker_buffer);
  370.   defsubr (&Sset_marker);
  371.   defsubr (&Scopy_marker);
  372. }
  373.